Shareware Grab Bag/Shareware Grab Bag.iso/050/turbtool.arc/CHAPTER6.PAS

Pascal/Delphi Source File | 1985-04-01 | 16.5 KB | 832 lines

{$A-}
PROGRAM CHAPTER6;
{$I TOOLU.PAS}
{$I FPRIMS.PAS}

var cmdptr:file;
PROCEDURE EDIT;
CONST
  MAXLINES=1000;
  DITTO=255;
  CURLINE=PERIOD;
  LASTLINE=DOLLAR;
  SCAN=47;
  BACKSCAN=92;
  ACMD=97;
  CCMD=99;
  DCMD=100;
  ECMD=101;
  EQCMD=EQUALS;
  FCMD=102;
  GCMD=103;
  ICMD=105;
  MCMD=109;
  PCMD=112;
  QCMD=113;
  RCMD=114;
  SCMD=115;
  WCMD=119;
  XCMD=120;

TYPE
  STCODE=(ENDDATA,ERR,OK);
  BUFTYPE=RECORD
    TXT:INTEGER;
    MARK:BOOLEAN;
  END;

VAR
  EDITFID:FILE OF CHARACTER;
  BUF:ARRAY[0..MAXLINES]OF BUFTYPE;
  RECIN:INTEGER;
  RECOUT:INTEGER;
  LINE1,LINE2,NLINES,CURLN,LASTLN:INTEGER;
  PAT,LIN,SAVEFILE:XSTRING;
  CURSAVE,I:INTEGER;
  STATUS:STCODE;
  MORE:BOOLEAN;







PROCEDURE GETTXT(N:INTEGER;VAR S:XSTRING);
VAR
  ch:char;JUNK:BOOLEAN;I:INTEGER;
BEGIN
  IF(N=0) THEN
    S[1]:=ENDSTR
  ELSE BEGIN
    i:=0;
    SEEK(EDITFID,BUF[N].TXT);
    repeat
      i:=succ(i);
      READ(EDITFID,s[i]);
      RECIN:=RECIN+1;
    until S[I]=ENDSTR;
  END
END;


FUNCTION GETMARK(N:INTEGER):BOOLEAN;
BEGIN
  GETMARK:=BUF[N].MARK
END;

PROCEDURE PUTMARK(N:INTEGER;M:BOOLEAN);
BEGIN
  BUF[N].MARK:=M
END;

FUNCTION DOPRINT(N1,N2:INTEGER):STCODE;
VAR
  I:INTEGER;
  LINE:XSTRING;
BEGIN
  IF(N1<=0)THEN
    DOPRINT:=ERR
  ELSE BEGIN
    FOR I:=N1 TO N2 DO BEGIN
      GETTXT(I,LINE);
      PUTSTR(LINE,STDOUT)
    END;
    CURLN:=N2;
    DOPRINT:=OK
  END
END;

FUNCTION DEFAULT(DEF1,DEF2:INTEGER;
  VAR STATUS:STCODE):STCODE;
BEGIN
  IF(NLINES=0)THEN BEGIN
    LINE1:=DEF1;
    LINE2:=DEF2
  END;
  IF(LINE1 > LINE2)OR(LINE1 <=0)THEN
    STATUS:=ERR
  ELSE
    STATUS:=OK;
  DEFAULT:=STATUS
END;

FUNCTION PREVLN(N:INTEGER):INTEGER;
BEGIN
  IF(N<=0)THEN
    PREVLN:=LASTLN
  ELSE
    PREVLN:=N-1
END;

FUNCTION NEXTLN(N:INTEGER):INTEGER;
BEGIN
  IF(N>=LASTLN)THEN
    NEXTLN:=0
  ELSE
    NEXTLN:=N+1
END;

FUNCTION PATSCAN(WAY:CHARACTER;VAR N:INTEGER):STCODE;
VAR
  DONE:BOOLEAN;
  LINE:XSTRING;
BEGIN
  N:=CURLN;
  PATSCAN:=ERR;
  DONE:=FALSE;
  REPEAT
    IF(WAY=SCAN)THEN
      N:=NEXTLN(N)
    ELSE
      N:=PREVLN(N);
    GETTXT(N,LINE);
    IF(MATCH(LINE,PAT))THEN BEGIN
      PATSCAN:=OK;
      DONE:=TRUE
    END
  UNTIL(N=CURLN)OR(DONE)
END;

FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
BEGIN
  IF(S[I]<>ESCAPE) THEN
    ESC:=S[I]
  ELSE IF (S[I+1]=ENDSTR) THEN
    ESC:=ESCAPE
  ELSE BEGIN
    I:=I+1;
    IF (S[I]=ORD('N')) THEN
      ESC:=NEWLINE
    ELSE IF (S[I]=ORD('T')) THEN
      ESC:=TAB
    ELSE
      ESC:=S[I]
    END
END;
FUNCTION OPTPAT(VAR LIN:XSTRING;VAR I:INTEGER):STCODE;
BEGIN
  IF(LIN[I]=ENDSTR)THEN
    I:=0
  ELSE IF(LIN[I+1]=ENDSTR)THEN
    I:=0
  ELSE IF(LIN[I+1]=LIN[I])THEN
    I:=I+1
  ELSE
    I:=MAKEPAT(LIN,I+1,LIN[I],PAT);
  IF(PAT[1]=ENDSTR)THEN
    I:=0;
  IF(I=0)THEN BEGIN
    PAT[1]:=ENDSTR;
    OPTPAT:=ERR
  END
  ELSE
    OPTPAT:=OK
END;

PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
BEGIN
  WHILE(S[I]=BLANK)OR(S[I]=TAB)DO
    I:=I+1
END;

FUNCTION GETNUM(VAR LIN:XSTRING;VAR I,NUM:INTEGER;
  VAR STATUS:STCODE):STCODE;
BEGIN
  STATUS:=OK;
  SKIPBL(LIN,I);
  IF(ISDIGIT(LIN[I]))THEN BEGIN
    NUM:=CTOI(LIN,I);
      I:=I-1
  END
  ELSE IF(LIN[I]=CURLINE)THEN
    NUM:=CURLN
  ELSE IF(LIN[I]=LASTLINE)THEN
    NUM:=LASTLN
  ELSE IF(LIN[I]=SCAN)OR(LIN[I]=BACKSCAN)THEN BEGIN
    IF(OPTPAT(LIN,I)=ERR)THEN
      STATUS:=ERR
    ELSE
      STATUS:=PATSCAN(LIN[I],NUM)
  END
  ELSE
    STATUS:=ENDDATA;
  IF(STATUS=OK)THEN
    I:=I+1;
  GETNUM:=STATUS
END;

FUNCTION GETONE(VAR LIN:XSTRING;VAR I,NUM:INTEGER;
  VAR STATUS:STCODE):STCODE;
  VAR
    ISTART,MUL,PNUM:INTEGER;
  BEGIN
    ISTART:=I;
    NUM:=0;
    IF(GETNUM(LIN,I,NUM,STATUS)=OK)THEN
      REPEAT
        SKIPBL(LIN,I);
        IF(LIN[I]<>PLUS)AND(LIN[I]<>MINUS)THEN
          STATUS:=ENDDATA
        ELSE BEGIN
          IF(LIN[I]=PLUS)THEN
            MUL:=+1
          ELSE
            MUL:=-1;
          I:=I+1;
          IF(GETNUM(LIN,I,PNUM,STATUS)=OK)THEN
            NUM:=NUM+MUL*PNUM;
          IF(STATUS=ENDDATA)THEN
            STATUS:=ERR
        END
      UNTIL(STATUS<>OK);
    IF(NUM<0)OR(NUM > LASTLN)THEN
      STATUS:=ERR;
    IF(STATUS<>ERR)THEN BEGIN
      IF(I<=ISTART)THEN
        STATUS:=ENDDATA
      ELSE
        STATUS:=OK
    END;
    GETONE:=STATUS
  END;


FUNCTION GETLIST(VAR LIN:XSTRING;VAR I:INTEGER;
  VAR STATUS:STCODE):STCODE;
VAR
  NUM:INTEGER;
  DONE:BOOLEAN;
BEGIN
  LINE2:=0;
  NLINES:=0;
  DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK);
  WHILE(NOT DONE)DO BEGIN
    LINE1:=LINE2;
    LINE2:=NUM;
    NLINES:=NLINES+1;
    IF(LIN[I]=SEMICOL)THEN
      CURLN:=NUM;
    IF(LIN[I]=COMMA)OR(LIN[I]=SEMICOL)THEN BEGIN
      I:=I+1;
      DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK)
    END
    ELSE
      DONE:=TRUE
  END;
  NLINES:=MIN(NLINES,2);
  IF(NLINES=0)THEN
    LINE2:=CURLN;
  IF(NLINES<=1)THEN
    LINE1:=LINE2;
  IF(STATUS<>ERR)THEN
    STATUS:=OK;
  GETLIST:=STATUS
END;

PROCEDURE REVERSE(N1,N2:INTEGER);
VAR
  TEMP:BUFTYPE;
BEGIN
  WHILE(N1<N2)DO BEGIN
    TEMP:=BUF[N1];
    BUF[N1]:=BUF[N2];
    BUF[N2]:=TEMP;
    N1:=N1+1;
    N2:=N2-1
  END
END;
PROCEDURE BLKMOVE(N1,N2,N3:INTEGER);
BEGIN
  IF(N3<N1-1)THEN BEGIN
    REVERSE(N3+1,N1-1);
    REVERSE(N1,N2);
    REVERSE(N3+1,N2)
  END
  ELSE IF(N3>N2)THEN BEGIN
    REVERSE(N1,N2);
    REVERSE(N2+1,N3);
    REVERSE(N1,N3)
  END
END;

FUNCTION MOVE(LINE3:INTEGER):STCODE;
BEGIN
  IF(LINE1<=0)OR((LINE3>=LINE1)AND(LINE3<LINE2))THEN
    MOVE:=ERR
  ELSE BEGIN
    BLKMOVE(LINE1,LINE2,LINE3);
    IF(LINE3>LINE1)THEN
      CURLN:=LINE3
    ELSE
       CURLN:=LINE3+(LINE2-LINE1+1);
     MOVE:=OK
   END
 END;

FUNCTION LNDELETE(N1,N2:INTEGER;VAR STATUS:STCODE):
STCODE;
BEGIN
  IF(N1<=0)THEN
    STATUS:=ERR
  ELSE BEGIN
    BLKMOVE(N1,N2,LASTLN);
    LASTLN:=LASTLN-(N2-N1+1);
    CURLN:=PREVLN(N1);
    STATUS:=OK
  END;
  LNDELETE:=STATUS
END;

FUNCTION CKP(VAR LIN:XSTRING;I:INTEGER;
  VAR PFLAG:BOOLEAN;VAR STATUS:STCODE):STCODE;
BEGIN
  SKIPBL(LIN,I);
  IF(LIN[I]=PCMD)THEN BEGIN
    I:=I+1;
    PFLAG:=TRUE
  END
  ELSE
    PFLAG:=FALSE;
  IF(LIN[I]=NEWLINE)THEN
    STATUS:=OK
  ELSE
    STATUS:=ERR;
  CKP:=STATUS
END;

FUNCTION PUTTXT(VAR LIN:XSTRING):STCODE;
VAR I:INTEGER;
BEGIN
  PUTTXT:=ERR;
  IF(LASTLN<MAXLINES) THEN BEGIN
    i:=0;
    seek(editfid,recout);
    lastln:=lastln+1;
    buf[lastln].txt:=recout;
    repeat
      i:=succ(i);
      WRITE(EDITFID,lin[i]);
      recout:=recout+1
    until lin[i]=ENDSTR;
    write(editfid,lin[i]);
    PUTMARK(LASTLN,FALSE);
    BLKMOVE(LASTLN,LASTLN,CURLN);
    CURLN:=CURLN+1;
    PUTTXT:=OK
  END
END;

PROCEDURE SETBUF;
BEGIN
(*$I-*)
  ASSIGN(EDITFID,'EDTEMP');
  RESET(EDITFID);
  IF (IORESULT<>0) THEN REWRITE(EDITFID);
(*$I+*)

  RECOUT:=0;
  RECIN:=0;
  CURLN:=0;
  LASTLN:=0
END;


PROCEDURE CLRBUF;
BEGIN
  CLOSE(EDITFID);ERASE(EDITFID)
END;

FUNCTION APPEND(LINE:INTEGER;GLOB:BOOLEAN):STCODE;
VAR
  EINLINE:XSTRING;
  STAT:STCODE;
  DONE:BOOLEAN;
BEGIN
  IF(GLOB)THEN
    STAT:=ERR
  ELSE BEGIN
    CURLN:=LINE;
    STAT:=OK;
    DONE:=FALSE;
    WHILE(NOT DONE)AND(STAT=OK)DO
      IF(NOT GETLINE(EINLINE,STDIN,MAXSTR))THEN
        STAT:=ENDDATA
      ELSE IF(EINLINE[1]=PERIOD)
        AND(EINLINE[2]=NEWLINE)THEN
          DONE:=TRUE
      ELSE IF(PUTTXT(EINLINE)=ERR)THEN
        STAT:=ERR
  END;
  APPEND:=STAT
END;

FUNCTION DOWRITE(N1,N2:INTEGER;VAR FIL:XSTRING):STCODE;
VAR
  I:INTEGER;
  FD: FILEDESC;
  LINE: XSTRING;
BEGIN
  FD:=CREATE(FIL,IOWRITE);
  IF(FD=IOERROR)THEN
    DOWRITE:=ERR
  ELSE BEGIN
    FOR I:=N1 TO N2 DO BEGIN
      GETTXT(I,LINE);
      PUTSTR(LINE,FD)
    END;
    XCLOSE(FD);
    PUTDEC(N2-N1+1,1);
    PUTC(NEWLINE);
    DOWRITE:=OK
  END
END;

FUNCTION DOREAD(N:INTEGER;VAR FIL:XSTRING):STCODE;
VAR
  COUNT:INTEGER;
  T:BOOLEAN;
  STAT:STCODE;
  FD:FILEDESC;
  EINLINE:XSTRING;
BEGIN
  FD:=OPEN(FIL,IOREAD);
  IF(FD=IOERROR)THEN
    STAT:=ERR
  ELSE BEGIN
    CURLN:=N;
    STAT:=OK;
    COUNT:=0;
    REPEAT
      T:=GETLINE(EINLINE,FD,MAXSTR);
      IF(T)THEN BEGIN
        STAT:=PUTTXT(EINLINE);
        IF(STAT<>ERR)THEN
          COUNT:=COUNT+1
      END
    UNTIL(STAT<>OK)OR(T=FALSE);
    XCLOSE(FD);
    PUTDEC(COUNT,1);
    PUTC(NEWLINE)
  END;
  DOREAD:=STAT
END;

FUNCTION GETFN(VAR LIN:XSTRING;VAR I:INTEGER;
  VAR FIL:XSTRING):STCODE;
VAR
  K:INTEGER;
  STAT:STCODE;

FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:
  XSTRING):INTEGER;
VAR
  J:INTEGER;
BEGIN
  WHILE(S[I]IN [BLANK,TAB,NEWLINE])DO
    I:=I+1;
  J:=1;
  WHILE(NOT(S[I]IN [ENDSTR,BLANK,TAB,
    NEWLINE]))DO BEGIN
    OUT[J]:=S[I];
    I:=I+1;
    J:=J+1
  END;
  OUT[J]:=ENDSTR;
  IF(S[I]=ENDSTR)THEN
    GETWORD:=0
  ELSE
    GETWORD:=I
END;

BEGIN(*GETFN*)
  STAT:=ERR;
  IF(LIN[I+1]=BLANK)THEN BEGIN
    K:=GETWORD(LIN,I+2,FIL);
    IF(K>0)THEN
      IF(LIN[K]=NEWLINE)THEN
        STAT:=OK
  END
  ELSE IF(LIN[I+1]=NEWLINE)
    AND(SAVEFILE[1]<>ENDSTR)THEN BEGIN
      SCOPY(SAVEFILE,1,FIL,1);
      STAT:=OK;
  END;
  IF(STAT=OK)AND(SAVEFILE[1]=ENDSTR)THEN
    SCOPY(FIL,1,SAVEFILE,1);
  GETFN:=STAT
END;

PROCEDURE CATSUB(VAR LIN:XSTRING;S1,S2: INTEGER;
  VAR SUB: XSTRING;VAR NEW:XSTRING;
  VAR K:INTEGER;MAXNEW:INTEGER);
VAR
  I,J:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  I:=1;
  WHILE(SUB[I]<>ENDSTR)DO BEGIN
    IF(SUB[I]=DITTO)THEN
      FOR J:=S1 TO S2-1 DO
        JUNK:=ADDSTR(LIN[J],NEW,K,MAXNEW)
      ELSE
        JUNK:=ADDSTR(SUB[I],NEW,K,MAXNEW);
      I:=I+1
  END
END;

FUNCTION SUBST( VAR SUB:XSTRING;GFLAG,GLOB:BOOLEAN):STCODE;
VAR
  NEW,OLD:XSTRING;
  J,K,LASTM,LINE,M:INTEGER;
  STAT:STCODE;
  DONE,SUBBED,JUNK:BOOLEAN;
BEGIN
  IF(GLOB)THEN
    STAT:=OK
  ELSE
    STAT:=ERR;
    DONE:=(LINE1<=0);
    LINE:=LINE1;
    WHILE(NOT DONE)AND(LINE<=LINE2)DO BEGIN
      J:=1;
      SUBBED:=FALSE;
      GETTXT(LINE,OLD);
      LASTM:=0;
      K:=1;
      WHILE(OLD[K]<>ENDSTR)DO BEGIN
        IF(GFLAG)OR(NOT SUBBED)THEN
          M:=AMATCH(OLD,K,PAT,1)
        ELSE
          M:=0;
        IF(M>0)AND(LASTM<>M)THEN BEGIN
          SUBBED:=TRUE;
          CATSUB(OLD,K,M,SUB,NEW,J,MAXSTR);
          LASTM:=M
        END;
        IF(M=0)OR(M=K)THEN BEGIN
          JUNK:=ADDSTR(OLD[K],NEW,J,MAXSTR);
          K:=K+1
        END
        ELSE
          K:=M
      END;
      IF(SUBBED)THEN BEGIN
        IF(NOT ADDSTR(ENDSTR,NEW,J,MAXSTR))THEN BEGIN
          STAT:=ERR;
          DONE:=TRUE
        END
        ELSE BEGIN
          STAT:=LNDELETE(LINE,LINE,STATUS);
          STAT:=PUTTXT(NEW);
          LINE2:=LINE2+CURLN-LINE;
          LINE:=CURLN;
          IF(STAT=ERR)THEN
            DONE:=TRUE
          ELSE
            STAT:=OK
          END
        END;
        LINE:=LINE+1
      END;
      SUBST:=STAT
    END;
FUNCTION MAKESUB(VAR ARG:XSTRING;FROM:INTEGER;
  DELIM:CHARACTER;VAR SUB:XSTRING):INTEGER;
VAR I,J:INTEGER;
   JUNK:BOOLEAN;
BEGIN
  J:=1;
  I:=FROM;
  WHILE(ARG[I]<>DELIM)AND(ARG[I]<>ENDSTR)DO BEGIN
    IF(ARG[I]=ORD('&'))THEN
      JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
    ELSE
      JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
    I:=I+1
  END;
  IF(ARG[I]<>DELIM) THEN
    MAKESUB:=0
  ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT))THEN
    MAKESUB:=0
  ELSE
    MAKESUB:=I
END;
FUNCTION GETRHS(VAR LIN:XSTRING;VAR I:INTEGER;
  VAR SUB:XSTRING;VAR GFLAG:BOOLEAN):STCODE;
BEGIN
  GETRHS:=OK;
  IF(LIN[I]=ENDSTR)THEN
    GETRHS:=ERR
  ELSE IF(LIN[I+1]=ENDSTR)THEN
    GETRHS:=ERR
  ELSE BEGIN
    I:=MAKESUB(LIN,I+1,LIN[I],SUB);
    IF(I=0)THEN
      GETRHS:=ERR
    ELSE IF(LIN[I+1]=ORD('G'))THEN BEGIN
      I:=I+1;
      GFLAG:=TRUE
    END
    ELSE
      GFLAG:=FALSE
  END
END;

FUNCTION DOCMD(VAR LIN:XSTRING;VAR I:INTEGER;
  GLOB:BOOLEAN;VAR STATUS:STCODE):STCODE;
VAR
  FIL,SUB:XSTRING;
  LINE3:INTEGER;
  GFLAG,PFLAG:BOOLEAN;
BEGIN
  PFLAG:=FALSE;
  STATUS:=ERR;
  IF(LIN[I]=PCMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN
      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
        STATUS:=DOPRINT(LINE1,LINE2)
  END
  ELSE IF(LIN[I]=NEWLINE)THEN BEGIN
    IF(NLINES=0)THEN
      LINE2:=NEXTLN(CURLN);
    STATUS:=DOPRINT(LINE2,LINE2)
  END
  ELSE IF(LIN[I]=QCMD)THEN BEGIN
    IF( LIN[I+1]=NEWLINE)AND(NLINES=0)AND(NOT GLOB)THEN
  STATUS:=ENDDATA
  END
  ELSE IF(LIN[I]=ACMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN
      STATUS:=APPEND(LINE2,GLOB)
  END
  ELSE IF(LIN[I]=CCMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN
      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
      IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN
        STATUS:=APPEND(PREVLN(LINE1),GLOB)
  END
  ELSE IF(LIN[I]=DCMD)THEN BEGIN
    IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN
     IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
     IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN
     IF(NEXTLN(CURLN)<>0)THEN
       CURLN:=NEXTLN(CURLN)
  END
  ELSE IF(LIN[I]=ICMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN BEGIN
      IF(LINE2=0)THEN
        STATUS:=APPEND(0,GLOB)
      ELSE
        STATUS:=APPEND(PREVLN(LINE2),GLOB)
    END
  END
  ELSE IF(LIN[I]=EQCMD)THEN BEGIN
    IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN BEGIN
      PUTDEC(LINE2,1);
      PUTC(NEWLINE)
    END
  END
  ELSE IF(LIN[I]=MCMD)THEN BEGIN
    I:=I+1;
    IF(GETONE(LIN,I,LINE3,STATUS)=ENDDATA)THEN
      STATUS:=ERR;
    IF(STATUS =OK)THEN
      IF(CKP(LIN,I,PFLAG,STATUS)=OK)THEN
      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
        STATUS:=MOVE(LINE3)
  END
  ELSE IF(LIN[I]=SCMD)THEN BEGIN
    I:=I+1;
    IF(OPTPAT(LIN,I)=OK)THEN
    IF(GETRHS(LIN,I,SUB,GFLAG)=OK)THEN
    IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN
    IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
      STATUS:=SUBST(SUB,GFLAG,GLOB)
  END
  ELSE IF(LIN[I]=ECMD)THEN BEGIN
    IF(NLINES =0)THEN
      IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN
        SCOPY(FIL,1,SAVEFILE,1);
        CLRBUF;
        SETBUF;
        STATUS:=DOREAD(0,FIL)
      END
  END
  ELSE IF(LIN[I]=FCMD)THEN BEGIN
    IF(NLINES =0)THEN
      IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN
        SCOPY(FIL,1,SAVEFILE,1);
        PUTSTR(SAVEFILE,STDOUT);
        PUTC(NEWLINE);
        STATUS:=OK
    END
  END
  ELSE IF(LIN[I]=RCMD)THEN BEGIN
    IF(GETFN(LIN,I,FIL)=OK)THEN
      STATUS:=DOREAD(LINE2,FIL)
  END
  ELSE IF(LIN[I]=WCMD)THEN BEGIN
    IF(GETFN(LIN,I,FIL)=OK)THEN
      IF(DEFAULT(1,LASTLN,STATUS)=OK)THEN
        STATUS:=DOWRITE(LINE1,LINE2,FIL)
  END;
  IF(STATUS =OK)AND(PFLAG)THEN
    STATUS:=DOPRINT(CURLN,CURLN);
  DOCMD:=STATUS
END;(*DOCMD*)

FUNCTION CKGLOB(VAR LIN: XSTRING;VAR I:INTEGER;
  VAR STATUS:STCODE): STCODE;
VAR
  N:INTEGER;
  GFLAG:BOOLEAN;
  TEMP: XSTRING;
BEGIN
  IF(LIN[I]<>GCMD)AND(LIN[I]<>XCMD)THEN
    STATUS:=ENDDATA
  ELSE BEGIN
    GFLAG:=(LIN[I]=GCMD);
    I:=I+1;
    IF(OPTPAT(LIN,I)=ERR)THEN
      STATUS:=ERR
    ELSE IF( DEFAULT(1,LASTLN,STATUS)<>ERR)THEN BEGIN
      I:=I+1;
      FOR N:=LINE1 TO LINE2 DO BEGIN
        GETTXT(N,TEMP);
        PUTMARK(N,(MATCH(TEMP,PAT)=GFLAG))
      END;

      FOR N:=1 TO LINE1-1 DO
        PUTMARK(N,FALSE);
      FOR N:=LINE2+1 TO LASTLN DO
        PUTMARK(N,FALSE);
      STATUS:=OK
    END
  END;
  CKGLOB:=STATUS
END;

FUNCTION DOGLOB(VAR LIN:XSTRING;VAR I,CURSAVE:INTEGER;
  VAR STATUS: STCODE):STCODE;
VAR
  COUNT,ISTART,N: INTEGER;
BEGIN
  STATUS:=OK;
  COUNT:=0;
  N:=LINE1;
  ISTART:=I;
  REPEAT
    IF(GETMARK(N))THEN BEGIN
      PUTMARK(N,FALSE);
      CURLN:=N;
      CURSAVE:=CURLN;
      I:=ISTART;
      IF(DOCMD(LIN,I,TRUE,STATUS)=OK)THEN
        COUNT:=0
    END
    ELSE BEGIN
      N:=NEXTLN(N);
      COUNT:=COUNT + 1
    END
  UNTIL(COUNT > LASTLN)OR(STATUS <> OK);
  DOGLOB:=STATUS
END;

BEGIN
  SETBUF;
  PAT[1]:=ENDSTR;
  SAVEFILE[1]:=ENDSTR;
  IF(GETARG(2,SAVEFILE,MAXSTR))THEN
    IF(DOREAD(0,SAVEFILE)=ERR)THEN
      WRITELN('?');
  MORE:=GETLINE(LIN,STDIN,MAXSTR);
  WHILE(MORE)DO BEGIN
    I:=1;
    CURSAVE:=CURLN;
    IF(GETLIST(LIN,I,STATUS)=OK)THEN BEGIN
      IF(CKGLOB(LIN,I,STATUS)=OK)THEN
        STATUS:=DOGLOB(LIN,I,CURSAVE,STATUS)
      ELSE IF(STATUS<>ERR)THEN
        STATUS:=DOCMD(LIN,I,FALSE,STATUS)
    END;
    IF(STATUS=ERR)THEN BEGIN
      WRITELN('?');
      CURLN:=MIN(CURSAVE,LASTLN)
    END
    ELSE IF(STATUS=ENDDATA)THEN
      MORE:=FALSE;
    IF(MORE)THEN
      MORE:=GETLINE(LIN,STDIN,MAXSTR)
  END;
  CLRBUF
END;

BEGIN
  EDIT;
  ENDCMD;assign(cmdptr,'SHELL.COM');execute(cmdptr)
END.